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INTRODUCTION AND BACKGROUND 

Under our June, 1987 proposal entitled 'Magnetic Signatures of Near-Earth 
Distributed Currents" we proposed to render operational a modeling procedure that had 
been previously developed to compute the magnetic effects of distributed currents 
flowing in the magnetosphere-ionosphere system. After adaptation of the software to 
our computing environment we would apply the model to low altitude satellite orbits 
and would utilize the MAGSAT data suite to guide the analysis. A contract to conduct 
this effort was awarded to LMSC in May, 1988. 

During the first year basic computer codes to run model systems of Blrkeland and 
ionospheric currents and several graphical output routines were made operational on a 
VAX 780 in our research facility. Software performance was evaluated using an input 
matchstick Ionospheric current array, field- aligned currents were calculated and 
magnetic perturbations along hypothetical satellite orbits were calculated. The basic 
operation of the model was verified. Software routines to analyze and display MAGSAT 
satellite data in terms of deviations with respect to the earth’s internal field were also 
made operational during the first year of effort. The complete set of MAGSAT data to be 
used for evaluation of the models was received at the end of the first year. A detailed 
annual report In May 1989 described these first year activities completely. That first 
annual report Is included by reference in this final report. 

This document summarizes our additional activities during the second year of effort 
under the contract, describes the modeling software and its operation, and includes as 
attachment the deliverable computer software specified under the contract. 


MODEL DESCRIPTION 

Description of Modeling Procedure 

The modeling software described below is designed to facilitate studies of the 
contributions that ionospheric and magnetospheric currents make to the magnetic 
fields measured on low altitude polar orbiting satellites. Emphasis Is placed on high 
latitude current systems because, as previously has been shown, large and highly 
variable perturbations of the geomagnetic field are associated with high latitude 
auroral phenomena. The routines compute the vector magnetic contributions at any 
point that arise from currents flowing in the ionosphere and along the magnetic field 
into the magnetosphere. The contribution due to a distant equatorial Ring Current is 
also included. 
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The basic modeling codes take, as input, an array of ionospheric currents 
distributed over a specified region of the polar ionosphere. Figure 1 illustrates the basic 
grid cell concept and shows the distribution of current locations for a coarse setup of 4 
latitude cells and 12 longitude cells. This 4x12 array is illustrative for the purpose of 
showing how the grid cells, the ionospheric currents, and the Birkeland currents relate 
to one another. In actual use of the model a much Oner grid consisting of many more 
grid cells would be employed. The view is looking down upon the polar regions with the 
earth's diple axis protruding from the center of the diagram. Magnitude and direction 
of the horizontal currents are specified for each point on a spherical surface at some 
altitude above the earth's surface. This altitude constitutes the base of the cell. The 
horizontal currents are shown in Figure 1 by arrows at the center of each grid cell. 

Each such horizontal current specification thereby locates a current cell, the bounds of 
which are determined by the density of current specification points. The latitude extent 
of the entire current system is bounded at the northern and southern boundaries by the 
first and last cell boundaries. In this illustration the latutude range is from 70° to 50°. 

Currents flowing outward and inward along magnetic field lines provide the sources 
and sinks for the horizontal ionospheric currents. These field-aligned currents 
constitute the Birkeland current system. In practice these currents are represented by 
straight filaments which are tangent to the magnetic field lines at the ionosphere (the 
base of the cell) and are three earth radii in length. A more complex model, in which the 
field-aligned filaments curved with the magnetic field lines all the way to the 
equatorial plane was tested. The increased complexity made a barely dlscemable 
difference in the final result and because of this reason and in view of the increased 
computation time the simpler concept was adopted. Once the ionospheric currents have 
been specified and the region boundaries have been determined the modeling codes 
compute the Birkeland currents at each cell boundary as required for the preservation 
of current continuity. In Figure 1 these currents are shown as circles located at each cell 
boundary. Each circle encloses about 90% of the kurtically distributed current. 

The magnetic field at any point is the vector sum of the contributions from all current 
elements in the system. Once the currents have been defined as described above the 
software can compute the magnetic field at any location. In practice, as will be 
described below, we compute the magnetic field along a satellite orbit through (and 
above) the current system so as to be able to relate the field signatures observed in real 
satellite data to the model fields. 

A very important aspect of the model is the representation of the currents. The current 
elements are like current carrying wires, in that they have thickness. But unlike wires, 
they have smoothly varying cross-sectional current density. The current density in 
each element is platykurtically distributed over the cross-section of the current 
element. The kurtic representation is one which varies as the hyperbolic secant of the 
square of the distance from the center of the element. This gives a more realistic 
representation of the currents and prevents large and sudden transitions of the 
magnetic field. 

Software Codes 

The Fortran source codes revived under this contract and submitted as 
deliverables items are attached as Attachment B. The suite of Fortran source code to 
directly carry out the modeling and display consists of more than 1500 lines of code. 
The component codes are listed in the following table. Also shown in the table are the 
input and output data files. 
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Table 1 : Magnetic Modeling Routines 
INPUT SOFTWARE CODE OUTPUT 


Run-time 

DIS.DAT + run-time 
DIS.DAT + run-time 
DIS.DAT + run-time 
MAG. DAT + run-time 


SCURDIS 

SAMPLT 

SBRKPLT 

SBRKALC 

SBRKPLT 


DIS.DAT 
Graphics 
Graphics 
MAG. DAT 
Graphics 


A functional description of each code follows: 

SCURDIS This Fortran routine sets up the current system with the input 
currents. The routine calculates all the necessary geometric 
parameters needed to specify the current elements and their location 
in space and writes these parameters along with the current 
magnitudes in the output file DIS.DAT. Runtime input information 
required for the code to run consists of specifying the number of cell 
rings, number of longitude sectors, inner and outer co-latitude 
boundaries of the current system, maximum current filament radius 
and latitude thickening exponent. 

SAMPLT This Is a graphical output routine that plots on a polar 
projection all Blrkeland currents required to complete continuity 
with the specified ionospheric currents. The circlegram shows the 
magnitude and location of the Birkeland current filaments. Input 
data file is the DIS.DAT file produced by SCURDIS. Additional 
runtime input includes a divisor which controls the current 
represented by each line of the circlegram. Output is graphical and is 
delivered to one of nine possible output devices specified under 
runtime control. The format of this output will be dependent upon 
facilites at the operator site. Standard Tektronics 4010 and laser 
postscript output are among possible options. 

SBRKPLT This is a graphical output routine that plots on a polar 
projection all horizontal ionospheric currents in the input system. 
The vectors show the location, magnitude and direction of each cell 
current filament. Input data file is the DIS.DAT file produced by 
SCURDIS. Additional runtime input Includes a multiplier which 
controls the length of the vector in terms of the current magnitude. 
Output is graphical and is delivered to one of nine possible output 
devices specified under runtime control. The format of this output 
will be dependent upon facilites at the operator site. Standard 
Tektronics 4010 and laser postscript output are among possible 
options. 

SBRKALC This routine calculates measurement positions for a specified 
satellite orbit and calls SMAGMOD. Input data file is the DIS.DAT 
file produced by SCURDIS. Additional runtime input includes the 
orbital altitude of the satellite, it's inclination and local time 
location of the orbit plane. The density of measurement points along 
the orbit Is also controlled by runtime input. A switch is provided at 
input to allow the user to select only a part of the global currents to 
determine the individual contributions of various parts of the 
current system to the magnetic field. It is also possible to compute 
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low latitude magnetic perturbations. This routine calls SMAGMOD. 
Output Is written to file MAG. DAT. 

SMAGMOD This routine calculates, for each measurement location, the 
net vector magnetic field due to all of the distributed currents. It is 
called by SBRKALC. At each measurement point the vector sum of the 
individual contributions from each and every current element in the 
system is computed and returned to SBRKALC along with the 
magnitude of the Birkeland current at each measurement point. 

SBRKPLT This is a graphical output routine that plots the three 
components of the magnetic perturbation at each measurement point 
along the satellite orbit specified in SBRKALC. Basic input array Is 
provided by MAG. DAT. User runtime choices allow the displayed 
perturbations to be cast into one of four coordinate representations: 
XYZ, NEV, SDV, and ABZ. Output is graphical and is delivered to one 
of nine possible output devices specified under runtime control. The 
format of this output will be dependent upon facilltes at the operator 
site. Standard Tektronics 4010 and laser postscript output are 
among possible options. 


Running a Model 

As an example of the model routines in actual use we illustrate in the following a 
complete run of the modeling system. The output is shown in Figures 2-4. A complete 
run through the system starts by running SCURDIS to set up the ionospheric input 
currents. In the version of SCURDIS contained In this report, up to 20 latitude cells and 
up to 24 longitude cells may be used. Each cell contains a specification for the vector 
ionospheric current at that location. Since Hall and Pederson conductivities are often 
used in physical descriptions of the auroral ionosphere and since ionospheric currents 
are often discussed in terms of the eastward and westward eleetrojects . we choose in 
practice to specify the ionospheric currents by their E-W and N-S components. The data 
file produced by SCURDIS contains Information regarding the location, direction, and 
magnitude of the currents to be passed on to subsequent programs in the sequence. 

Once the complete current specification has been set up by CURDIS, two plotting 
programs (SAMPLT and SCURPLT) are available to view the ionospheric and the 
resulting field-aligned currents. Figure 2 depicts the input ionospheric current system 
used for this example. Looking down upon the earth's polar region the figure shows, on 
a local time vs latitude polar projection, the ionospheric current vectors at each grid 
cell input point. This current system is the direct input for the model. In this model run 
a cell matrix of twenty latitude rings by 24 longitude sectors is used to represent an 
ionospheric current that has a strong eastward electrojet throughout the post noon 
sector and Into the morning sector. The current is restricted to the latitude range from 
57 to 85 degrees. This output is produced by the SCURPLT program. 

The model calculates the field-aligned currents required to maintain current 
continuity. For this example the resulting field-aligned current distribution through 
an imaginary spherical shell above the ionospheric currents is shown in Figure 3. 
Field-aligned currents flow in and out at each grid point as required to maintain 
current continuity. Since there is a string divergence In the ionospheric currents along 
the noon meridian (see Figure 2) there Is a strong downward field-aligned current at this 
location as seen in Figure 3. Current flows upward or downward along magnetic field 
lines as indicated by the horizontal or vertical hatching, respectively. 

The product of ultimate interest Is the magnetic field at any point. The magnetic 
perturbation code (SBRKALC) Is set up to receive a specified satellite orbit and to 
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calculate the magnetic field perturbations at points along that orbit for one of several 
possible coordinate systems. SBRKALC is given the orbital parameters for the satellite 
and calculates the magnetic perturbations due to any one or all parts of the current 
system. The resulting information is written to the file MAG. DAT which In tem may be 
plotted using the program SBRKPLT. As an example. Figure 4 Illustrates the magnetic 
field perturbations due to the model current system shown in Figures 2 and 3 that a 
satellite at 450 km altitude would see as it passes over the current system in an evening 
to morning orbit as shown in the upper right hand clock dial. Perturbations are shown 
for the three vector components northward {N), eastwardward (E) and vertical (V). The 
bottom panel shows the magnitude of the local field-aligned currents that the satellite 
passes through while the magnetic perturbations In the upper three panels are due to all 
of the currents In the entire system. The coordinate system for output of the 
perturbations is selected at runtime in BRKPLT. 


Other activi ties during second year 

An abstract was submitted, and accepted for presentation, at the spring 1990 American 
Geophysical Union meeting of results of the investigations carried out under this 
contract. The paper is entitled, "A Method for Computing Magnetic Perturbations at 
Satellite Altitude due to Distributed Currents in the Ionosphere and Magnetosphere". 
The paper emphasizes the capabilities of the model as a tool to examine the relative 
contributions of the magnetic perturbations which result from the various components 
of the current distribution. The capability to selectively "switch on" parts of the current 
system while evaluating the magnetic perturbations is a powerful tool for 
understanding the sources of the magnetic perturbations seen on earth-orbiting 
satellites. In the computer model there are four distinct current components: 
ionospheric N-S. Ionospheric E-W. field-aligned, and ring current. Of course the 
currents themselves are Intimately tied together by the requirement for current 
continuity and cannot be Independently controlled without creating a physically 
impossible situation. The magnetic contribution, however, of each of the four can be 
selectively switched on to determine the effect of any one of them on the magnetic field 
at any measurement point. This provides a unique analysis tool that the natural 
environment cannot provide. It allows us to examine singularly the effect on the 
magnetic perturbations seen at the satellite due to each major component In the global 
current system. Such a diagnostic is an indispensable tool for understanding the 
behavior of the magnetic perturbations In orbit. A copy of the abstract is attached to 
this report as Attachment A. 

Most of our progress with respect to the MAGSAT data was directed toward 
getting the data tapes and modifying our MAGSAT analysis routines to run on the VAX 
780. The software has been transported to the VAX and Is running successfully. Several 
figures In our first annual report showed sample plots from these analysis routines, 
and will not be repeated here. 
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ATTACHMENT A 

Abstract of paper submitted to Spring 1990 
American Geophysical Union Meeting 
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A Method for Computing Magnetic Perturbations at Satellite Altitude 
due to Distributed Currents in the Ionosphere and Magnetosphere 

D. M. Klumoar (Lockheed Palo Alto Research Laboratory, Palo Alto, 
CA, 94304; 415-424-3288; SPAN mail LOCKHD::KLUMP) 

Low altitude magnetic survey satellites respond to the main magnetic 
field, to crustal anomaly fields, and to fields produced by currents in 
the ionosphere-magnetosphere system. One sub-discipline of space 
sciences endeavors to describe the space currents and relate them to 
processes in the magnetosphere and ionosphere. It is generally as- 
sumed that the entire observed magnetic perturbation is due to currents 
close to the satellite with a simple planar sheet current geometry. 

Given these assumptions one obtains an approximation for the local 
field-aligned currents. Contributions from distant sources are ignored. 
In the field of terrestrial geomagnetism the space currents represent a 
large temporally varying source of contaminating signal that must be 
removed to deduce the main field and/or crustal anomaly fields. Steep 
gradients due to local effects are readily recognized but larger-scale 
perturbations are a severe cause of inaccuracies. We illustrate here the 
use of a modeling routine, which has application to each of the above 
disciplines. The technique computes the magnetic field along a satel- 
lite orbit due to distributed electrical currents in the ionosphere and 
magnetosphere. It takes as input a description of the distributed cur- 
rents over the entire high latitude ionosphere and computes the mag- 
netic contribution at each point from the ensemble of currents in the 
system. Using this technique we input realistic current distributions 
and calculate the resulting magnetic perturbations along a satellite 
orbit. The modeling software is useful as a research tool for analyzing 
the relative contributions of local and more distant currents at a satellite 
and therefore generally as a tool in understanding the sources of the 
magnetic purtabation signatures. Various portions of the input cur- 
rents can be controlled independently, or turned off completely, so as 
to allow a versatility to "experiment" that is not found in nature. Since 
the model requires an ad hoc input current system it is not, in its pre- 
sent form, suitable for uniquely determining the currents that give rise 
to a specific measured magnetic perturbation profile. For that one 
requires a solution to the inverse problem. As an application of the 
technique we show distributed current systems which produce 
magnetic signatures that compare favourably with actual Magsat 
measurements and illustrate how the different components of the 
current system individually contribute to the magnetic perturbation. 
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ATTACHMENT B 
FORTRAN Source Codes 
Magnetic Field Model 
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SCURDIS 


SOURCE CODE 



non (lflnnnn 


c SCURDIS.FOR revision history, Sumner, 1988 
c John L. Jamison, for Dr. DM Klumpar 

® Lockheed Palo Alto Research Laboratory 

c 0/91-20 B/255 


6/29/ee 

JhJ 

made this "Simple" version of curdis 

added IHCLDDB for standard! rat ion of data decl 

changed AMPS to asp 

6/28/8 $ 

JLJ 

added "Units" in value input prompts, and 
input-verification code 

6/28/88 

JU 

nhsngad l-M currants in loop 40000 


CeeseeesessssssseseiMHteeeaeaeaeaejnHreftessesseseseseee****************} 

cordis ornns a currant distribution array and 
POTS IT ino A DATA VILA, DIS.DAT 

IIMMMMMMMMMMMMMMMMMMMMMMMMMMeetieemeem) 

subroutine SCORDIS (inter, pnuet.pauel, pall, pol2,prf, pdf, pncode) 

Include ‘ model : [staple] sbrk. ino' 

DXMAMIOM CL|2,21) 

DD4SMAI0M TCL(2,21) 

DIMANSIOA CLI(2,21), TMU (2,21) 

aaai. aa i.»mn> 

DATA PI / 3.14159265 / 

DATA U / *371000. / 

DATA ALTI / 120000. / 


Integer pauet, paced., pncode 
seal prf,pdf, pell, poll 

if (later. eq.0) then 
nusd-pouel 


rfr^rf 

df-pdf 

di-poll 

ol2-pcl2 


goto 2000 
eadlf 

write (5.*) 

•rite (5, *) * CORDIS. SXX' 

write (5,*) 

00999 VOUTS (5,01000) 

01000 FORMAT (’llater nueber of Cell Ring* [ WTRGSR.l. .20 ) ; ') 

mad (3, •) mart 

it <«aat .It.l.or.nuet ,gt.20) goto 999 

c 

01009 WRITS (5,01010) , _ . 

01010 FORMAT ('flnter nueber of cell* per 360 deg longitude 

s ' [ IMTSOSA. 1. .24 ) : ') 

MAD (3,*) «0ML 

If (nuel.lt.l.or.nuel.gt.24) goto 1009 


c 




01019 WRITE ( 5 , 01020) “ 

01020 FORMAT (' $Kntar innar and outar colatltudaa of dng ' 

* ' t REAL, 0.0 . . 90.0 ] : ') 

READ (5,*) CL1, CL2 

If ( (ell . It .O.O.or .ell .gt . 90.0) .or . (cl2.lt .0.0.or.cl2.at . 90 0) ) 

* goto 1019 
C 

WRIT* (5,01040) 

01040 FORMAT ('(Kntar max radius of currant fllaaants 

* ' ( REAL, motors ) : ') 
rood (5,*) rf 

WRIT* (5,01050) 

01050 format ( ' lEotar latitudinal t h i clo n ing axponant : ' ) 

RSAD (5,*) OF 

C 

WRIT* (5,01060) 

01060 FORMAT ( ' flntar Modal ouatoar : ' ) 

RSAD (5,*) WOODS 


2000 oontlnua 
C 

CIIMHMMMHIIIHINMMMMMUHMHIIMMIIHIIIIHHMHHMM) 

C "** U > OF 10000 osnwss thickness of CORRXWT FILAMENTS: 

C *••• FOR F-A CORRSWTA SUPPLYING S-W CURRENTS OR I - 1; 

C ***• FOR N-8 CURRENTS ON I - 2; 

C *44* FOR *-W CURRENTS ON I - 3. 

C 

DO 10000 X m 2, 4 

do ioooo j - l, wan 

DO 10000 E - 1. NUKL 

TF (I, J,E) - 1 . 089/ ( ( ( ( ( J- . 5) • (CL2-CL1) 

1 /WOn ♦ CL1) /CL2)**DF) • (RF**2) ) 

ioooo comtxnue 

C ■■■■£,?<■. '• 

C **•• LOON 20000 DEFINES THICKNESS OF CURRENT FILAMENTS 
C •••• FOR F-A CURRENTS SUPPLYING N-B CURRENTS . 

C 

N - NUMC 4 1 

DO 20000 J • 1. W 

DO 20000 E « 1, WUML 

XF(l.J.E) m 1.0S»/(((((J-1)*(CM-'CU)/NDWT + CU) 

1 /<X2)44DF)*(RF4*2)) 

20000 CONTINUE 

C ***« MOWS 30000 AMD 40000 DEFINE CURRENT FEE JLOCt FOR N-8 AND E-W REST, 

c 

DO 30000 J - 1 , HUNT 

DO 30000 E - 1, NUKL 
R • -1./2. 

IF (E.OT.EUML/2.) S-I./2. 

SSVa.J.K) • S 
30000 CONTINUE 

DO 40000 J - l.NUMT 

DO 40000 E ■ 1, NUKL 

*•-.5 

IF (E .OT. 12.4NUNL/24.) S - 0.5 
*sg>(2. J.K) - 8 
40000 CONTINUE 


UUU i-OUU 


C **** LOOPS 50000 AND 60000 DEFINE LENGTH OF CURRENT FILAMENTS 
C *•*• AND THEIR LOCATION IN SPACE 
C 


DO 50000 I - 1, 2 
DO 50000 J - I, N 

CL(X,J) * ( (CL2-CL1) * (I*J-1) / (I*NUMT) + CL1)*PI/180. 
SCL(I.J) - SIN (CL (I, J) ) 

CCL(I.J) - COS (CL <1. J)) 

- TAN (CL (I, J) ) 

- ATAN (2 . /TCL(I, J) ) 

- SXM(CLX(X,J) - CL( I,J)| 

• C0JMCU(X,J) r CMI.OT)) 

- - cl(i.j)) 

(Mt ♦ lt«)»(Ca(I,J) - SCL(I, J) /TND(I.J)) 
(RE ♦ ALTI) *SCL(I, J) /SMD (I, J) 

(RE ♦ ALTI) *3. 


TCL(I.J) 

CLX(I,J) 

aaj(z.j) 

8MD (I, J) 
TMU (I, J) 

Rxru.j) 

RB(I.J) - 
RT(I.J) - 


50000 CONTINUE 
C 

DO (0000 E - 1, NEXT 

REX (E) * (RE ♦ ALTI)*(COS(CLU,X)~CL<2.X)))/CCL<2,X) 
RX(l.K) - REX (K)*SCL(2,X) 

1 - (RE 6 ALTI) *8IN (CL (2, K) - CL(I.K)) 

RI (2, X) - RX (1 , X) ♦ 2 . • (RE ♦ ALTI) 

1 *8XN(CL(2,K) - CL(1,K)) 

EXE (X) « RE ♦ ALTI 

E EJ(K ) • EXE (X) *TAN (PI/NUML) 

(0000 OONTXEOB 




• ••• LQON 70000 DEFINES THE RING CURRENT 


RIBCA-«.*RX 

EINCB-4 . * RE* TAN (PI/NUML) 
DO 70000 X-l.NUML 

TEA (X)—X. 008/ (1000**2) 
AMPE(I)-l. 

0000 O ONTXAU E 


98888 


ODEN (aNIt-X.NAW-'OIS.nAr.TWE-'EBN') 


NEXTE 

NRITE 

NRXTE 

MUTE 

MUTE 

■RISE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 

MUTE 


11: :! 

d.*» 

a.*) 

a.*) 

a,*) 

a,*} 

ix.«) 

a.*) 

a.*) 

a,*) 

(X,*) 

(X.*» 

a.*> 

n.*) 

a.*) 

u.*> 

(X,*) 

a,*> 


NOOK. DE 
CLX, CL2 
mm T NUML 

( ( (TP (I, J,X) , X-l.NUML). J-l.N), 1-1,4) 

( ( («uqp(X, J.K) , X-l.NUML), J-l.NUMT), 1-1.2) 
((RXr(X.J), J-1,N>, X-1,2) 

(<RB(X,J), J-l.N). 1-1,2) 

‘ 1-1.2) 


(UNIT-1) 


<(KK(X.J). J-l.N). 

(RXX(X), X-l.NUMT) 

(RXX(X) , I— 1, NUMT) 

(REJ(X), X-l.NUMT) 

((EX(X.J), J-l.NUMT), 1-1,2) 
( (SCL(X, J) , J-l.N), 1-1.2) 
((CCL(X.J). J-l.N). 
((SMD)I.J), J-l.N). 

( (CUD (X, J) , J-l.N). 

RXNCA, RINGB 
(TPR(X) .X-l.NUML) 

(AMPR(X) , X— l.NUML) 


X-X.2) 

1 - 1 . 2 ) 

1-1.2) 


C 

Cl 


188888888888888888888888888888888888888) 





RETURN 

END 




SAMPLT 


SOURCE CODE 



Birkfield Current Ampere Plot 


Revision History 

2-JU1-88 
30- Jun-88 


JL Jamison, lor DM Klumpar 

Lockheed Palo Alto Research Laboratory 

0/91-20 B/255 


cleaned up Input prompting 

added SBRX.INC to standardize declarations 


C AMPLY SHOWS CURRENT FLOWING THROUGH THE SURFACE OF A SPHERE 

C sees JUST ABOVE THE IONOSPHERIC CURRENTS . 

C ***• EACH CIRCLE REPRESENTS A FIELD ALIGNED CURRENT FILAMENT AND 
C ***• ABOUT 90 PERCENT OF THE PLATICURTICALLT DISTRIBUTED CURRENT 
C ***• IS THEREIN ENCLOSED. 

C #ss* BACH LIMB IN ONE OF THESE CIRCLES REPRESENTS ONE AMP (NUMBER 
C *•** 0FLHR8 , 

c 

caiBHaiisiaiaiaesmeaseeeeeBeBBeeseeemseeessseeeeedeeeeeeeeeeeeee) 

c 

subroutine saaplt (inter, pfnue, pdlv) 

inolude 'model: [slsg>lajabrk,inc' I JLJ 

o DIMENSION AMP (2, 20,24) , TP(4,21,24) 

character *2 faun, pfnun : 

character *11 darray /' DIS.DAT; ' / 

integer inter- . 

real pdlv 

REALM INCL, MLT 

DATA HI 7 3.14159265 / ... ... 

DATA CF / 1 . 25948-6 / 

DATA INCL. THTA / »WCL7 1THTA' 7 < 

C 

caaaaaaaaaaaaaaaaaaB8BBa88a8BBBB88BBBB88a88B88B888888B88B888888B8888B) 

c 

write (6,997) 

00997 format (* 4') 

write (6,*) ' SAMPLT.EXE Birkeland Field-Aligned ' 

* //'Current Distribution' 
write (6,998) 

00998 fonaat('3') 

if (inter. eq.O) then 
f non ( 1 : 2 ) «p fnue ( 1 : 2 ) 
dlv ■» pdlv 
goto 2000 
endlf 

WRITE (6,01000) 

01000 FORMAT ('BEnter DIS.DAT version number [ Integer ) : ') 

READ (6,01010) FtfUM 
01010 FORMAT (2A) 
c 

WRITE (6,01020) 

01020 FORMAT ('BRnter clralegraa DIV factor [ Real ] : ') 

READ (6.*) DIV 

C 

02000 DARRAY (9: 10)»FNUM(1 : 2) 




non nnnnnn nnnnn oo 


If (inter. eq.l) then 

write (6,*) 'File : ' , darray (1 : 10) 
write (6,*) 'Div : ' , div 
write (6,*) 
endif 

CALL CALCMP (X, Y, 2, 0) 

CALL CALCMP (X, Y, 0,2) 

XORC >5.6 
YORG -5.5 

CALL CALCMP (XORC, TORS, 0, 3) 

CALL GRAIN (0.0) 

cell pot info (derray (1 1 11), 7 .8,1.5, .1, . false . ) 


cBmmmaeeeeeetieaimmmmeegeeaiessemmeeeeeeeeeeeeeeeee) 

OF KB (0BIT-1 , KAKR-DARRAY , TYPE*' OLD' ) 

RKAD (1, *) VCODK 
READ (1,*) CL1, CL2 
READ (1, *) BOUT, NUNL 
N - MONT + 1 

READ (1,*) ( ( (TP (I , J, K) , K— 1, NUML) , J-l.H) , 1-1,4) 

READ (1,*) (((AMP(I,.J,K), X-l.WML), J-1,NUMT),I-1,2) 

CLOSE (UMIT-l) 


B - MONT + 1 

DO 20000 HT ■ 1, 2 

00 20000 X • 1, N. : 

00 20000 J.« 1, NUML 

::::::::::::::::::::::::::::::: ::::::::: 


*»*« THIS SECTION CALCULATES THE CURRENT PER FILAMENT 

IF ( (BT .BQ. 2) .AND. (I .BQ. N)) OO TO 20000 
f » ( (Xrl. /NT) * (CL2-CU) /NOME + CLl)/40. 

XL - -4. 5*P*COS (2 . * (J+MT/2. -1 . ) *PI/NUML) 

TL - -4 . 5*F*SIH (2 . * ( J+NT/2 . -1 . ) *PI/HUML) 

FAMP - AMP <1,1, J) 

IF ( (NT .BQ. 2) .AND. (J L». HTML)) 

1 FAMP - AMP (2,1. J+l) - AMP (2,1, J) 

XT < (NT EQ. 2) .AND, (0 .BQ. N0ML) ) 

1 FAMP - AMP (2,1.1) - AMP (2. 1, WML) 

IF ( (NT .BQ. 1) -AND. (I .CT.l)) 

1 FAMP - AMP (1, 1, J) - AMP(l.I-l.J) 

IF ((NT .BQ. 1) .AND. (X ;BQ. N)) : FAMP » ~AMP(l,NUMT,J) 
IF (FAMP .BQ. 0.) GO TO 20000 


•••• LOOP 21000 CALCULATES THE RADIUS 0F BACH FILAMENT 
»»•* AMO DRAMS THE CIRCLE REPRESENTING XT. 

RF - SORT (1.089/TP (NT, I, J)) 

CALL CALCKP (XL, XL, 0,1) 

PRAD— RP*CF 

CALL CALCKP (XL, TL, 1 , -5) 

CALL ARC (PRAD, 0., 360.) 

CALL CALCMP (XL,TL, 0, -5) 




c • * * * 


XXX>PS 22000 AND 23000 DRAW THE LINBS IN EACH CIRCLE THAT 


**** SHOW THE CURRENT IN EACH FILAMENT, 22000 FOR IN AND 23000 FOR OUT. 

IF (ABS (FAMP/DIV) .LT. .05) GO TO 20000 
NLINB » INT(ABS(FAMP*10./DIV) + .5) 

IF (FAKP .LT. 0.) GO TO 20300 
DO 22000 L » 1, NLINE 

XW - RF*CF*SCRTU.-(l.-L/((NLINE+l)/2.))**2) 

X - XL - XV 

Y « YL + RF»CF* (1 . -L/ ( (NLINE+1) /2 .) ) 

CALL CALCMF (X, Y, 0, 1) 

X ■ XL ♦ XH 

Y - XL ♦ RP*CF* (I . -L/ ( (NLINE+1 ) /2 . ) ) 

CALI. CALCMF (X.Y, 1,1) : 

cost mux 

I»<FAMP ,CT. 0.) CO TO 20000 
DO 23000 M - 1, NLINB 

YW - RF*CF*SQRT (1 . - (1 . -M/ ( (NLINE+1) /2 . ) ) **2) 

X • XL ♦ RF*CP* (I . -M/ ( (NLINB+1) /2 . ) ) 

T "YL - TO 

CALL CALCMF <X,Y, 0,1) 

x - » < mim+i) /a.)) 

Y - YL + YM 
CALL CALCMF (X,Y,1,1) 

CONTINUE 


22000 

20300 


23000 

C 




20000 CONTINUE 
C 

caeeaaaeeaaaaeeeaeeaeaeaaeaeeeeaaaeeeeaeeeaaaaaaeeeeeeeaaaeaaeaaaeeae) 

c 

C •*** LOOPS 30000 AMD 40000 DRAM THE LATITUDE CIR CLES AMD 
C **»• ML* LIMES AMD LABSL8 RESPECTIVELY , 

C 

CALL CALCMF <0.,0.,0,1) 

DO 30000 I - 1, 4 
F RAD-1. 125*1 
CEl-l. ARC (FRAD, 0. , 360. ) 

30000 C0WTXXQX 
C 

DO 40000 I » 1, 12 
TH - (I-l)*FI/«. 

ST - RIM(TH) 

CT - COS (TH) ■•I 
XL - 4,5*CT 
YL - 4 . 5*ST 
X - XL - 3.375*CT 

Y - YL - 3.375*ST 
CALL CALCMF (X,Y, 0,1) 

X - XL 

Y - YL 

CALL CALCMF (X,Y, 1,1) 

MLT - 2.* (1-1) 

XM - XL ♦ . 7*CT + -105 
TO - YL + . 5*ST - ,07 
IF (MLT .CT. 9) TO - TO - .14 
CALL MUMBXR(XM,YM, .21. MLT, SO. »'"1) 

40000 CONTINUE 
C 


C **** LOOP 50000 DRAMS TOO REPRESENTATIVE FILAMENT CROSS-SECTIONS 
C **•* ONE SHOWING CURRENT IN, THE OTHER, CURRENT OUT. EACH HAS 
q e RADIUS OF 400000 METERS AND A CURRENT OF TEN AMPS. 

C 


ROP - 400000. 




DO 50000 I - 1, 2 

GO TO (50010,50020) I 
50010 XL - 5.3 

XL - -2.5 
GO TO 50030 
50020 XL - 5.3 

YL - 1.9 

50030 PRAD»ROP*CP 

CALL CALCKP (XL, XL, 0,1) 

CALL ARC (PRAD, 0 . , 360 . ) 

CO TO (50040,50050) Z 
50040 DO 52000 J - 1, 10 

w - ROP*CF*S0RT tl . * (1 . -a/5 . 5) **2) 

X - XL - XH 

x - xl + Rop*ar* a. -a/s. 5) 

CALL CALCKP (X,T, 0,1) 

X - XL + XW 

r - TL + ROP*CP* (1 . -J/5 .5) 

CALL CALCKP (X.X, 1,1) 

52000 COHTIirUX 

GO TO 50000 

50050 DO 53000 J - 1, 10 

XW - R0P*CP*SQRT(l.-(l.-J/5.5)**2) 

X - XL + RC»*CP*(l.-J/5.5) 

T - XL r XW 

CALL CALCKP (X,X, 0,1) 

x - xl ♦ w»>*ar* u.-j/s. 5) 

X - XL ♦ XW 

CALL CALCKP (X.X, 1,1) 

53000 COHTHTOB 

50000 cowtihus 

ciiiiiimiimHiiiiiiimHaMatiMMHiiHitiMttaiMiitiBteaim) 

c 

SXMBOL (6. 7, -5 ■ 07, . 28, 22HD1STRIBOTION OF FIELD ,90. ,22} 
riT.I. SXMBOL (999., 999., .28, 16HALIGHED CORRBHTS, 90 . , 16) 
CURR»DXV/10. 

CALL SXKBOL<7.5,-5.21, .14,11BCURREHT IS ,90. ,11) 

CALL HUMBER(999. , 999, , .14, CURB, 90. ,2) 

CALL SXMBOL(999. , 999. , .14, 9B AMP/LINS, 90. , 9) 

CALL SXMBOL (5. 5, -1.9, . 28, 2HIH. 90. . 2) 
rn-i. SXMBOL (5 .5,2.5, .20, 3 HOOT, 90. ,3) 

ROODS • WOODS ' 

CALL SOMBBR (8.0, -5.07, . 14, ROODS, 90. ,0) 

CALL SUMBSR(999, , 999, , , 14,CL1, 90. , 0) 

CALL HUMBER (999., 999., .14,02, 90. , 0) 

RCHT-MUHT 

HUMBER (999., 999., . 14, RUNT, 90 . , 0) 

RUML-HUML 

rmt.T. HUMBER (999., 999., .14,RUML, 90. , 0) 


CALL PAUS 

riT.I. CALCKP (X,X, 1000, 2) 



RXTURM 

EHD 


progru iioplt It 

0*11 »*Bf>lt Tl, ' ' « 

•top 
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SCURPLT 


SOURCE CODE 



Birkland Current Distribution Plotter 


C SCURPLT . FOR 
c 

c JL Jamison, for DM Klumpar 

c Lockheed Palo Alto Research Laboratory 

c 0/91-20 B/2S5 

c 

o Revision History 

O y\ ' .-'V 

o 12-JU1-88 JLJ made into callable procedure 

o 2- Jul-88 JLJ cleaned up input prompt s 

o 30- Jun-88 JLJ added 'SBRK.INC' to standardize declarations 

a 

a : ■ > £;,&/:■ . . : ;; , ; j \: ; ? i:|iyy:: : :<>•>. 

C*s******s***s*****sss**s**#***##*#s***s********e*e*e*ee******* ***********) 

C 

C CORPLT SHOWS THB CURRENT VBCTORS IN THE IONOSPHERE 

C 

caagaaeaaagggggggggggggggggggggggaggeegggggagagagggggggggggggggggggggggggg) 

c 

subroutine scurplt (inter, pfnum, pour) 
include ! • aodel : . I simple] ebrk.lno' 
aharactar*ll darray /' DIS . DAT; '/ 
character*2 fnua, pfnue 
integer** inter 

REAL** MLT, pcur 
DATA PI / 3.1*159285 / 

C 

cggggiiaiggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggggg) 

c 

write (6,997) 

0997 ; format (' 4' ) 

write (6,*) ' SCURPLT. EXE Birkeland Current Distribution' 

* // ' Plotter' 

write (6,*) ' Simple Model' 

write (4,998) 

0998 format ('2') 

if (inter. eq.O) then 
fnum(l:2)-pfnua(l:2) 
cur-pcur 

goto 2000 
endif 

WRITE (6,0X000) 

01000 FORMAT (' (Enter DIS. DAT version number [ integer ] : ') 

READ (6,01010) FNUM 
01010 FORMAT <2A) 

C ■ : '-V 

RSUTB (6,01020) • • , , , . 

01020 FORMAT ( ’(Enter Current Magnitude ( Real ] : ) 

READ (6,*) CUR 
C 

02000 DARRAY(9:10)-FMUM(1:2) 

if (inter. eq. I) than 

write (6,*) ’File : ' .darray (1:10) 

write (6,*) 'Current : ' , crur 
write (6,*) 

endif ' 

OPEN (UNIT-1 , NAME “DARRAY, TYPE-* OLD' ) 

READ (1,*) NCODB.DP 

REAP <!■«) CL1 , CL2 





READ (1,*) HUNT, NUML 

READ (1,*) ( ( (TP (I , J, K) , K=1,NUML), J=1,NUMT+1), 1=1,4) 

READ (1,*) (<<AHP(I,J,K), K=1,NUML), J=1,NUMT), 1=1,2) 

CLOSE (UNIT-1) 

CALL CALCMP (X, 1,1,0) 

CALL CALCMP (X.Y.0,2) 

CALL WINDER (0 . , 14 . , -S . 6, 8 . 4, 0 . , 11 . , -5. 5, 5. 5, 1) 


call put Info (darray (1:11) , 7. 8, 2.3, .10, . falsa. ) 

C 

ceggegaegeegggggeggggaaBagaeaasBeggggegggggggggggggggggggggggggggggggggggg) 

c 

C + *** LOOT 10000 DRAW8 THE VECTORS AND THBIR BEADS *»** 

C - -?C' ; : --i ; : v ■ 

DO 10000 I - 1, HUNT 
DO 10000 J - 1, NUML 
C 

C •*«* T0Z8 PART DRAMS THE VECTORS. **** 

r»(CLl+(2.*I-J..)4(CLi-CU)/(2.*iroilT))/40. 

XL— 4 . 5*P*C08 (2, * M-,5) *PI/HUML) 

YL— 4 . 5*V*SIN (2 . • ( J- . 5) *PI/HUML) 

CAI.T. CALCMP (XL, YL, 0, 1) 

nr ( (AMP (1, 1, J) **2+AMP (2,1, J) **2) .BQ. 0 . ) CO TO 10000 
XP*XL4CQR* (AMP(1,I, J)*XL-AHP(2,X» J) *YL) /SQRT (XL**2+YL**2) 
YT-YL+CUR* (AMP (1, X. J) *YL+AMP (2, X, J) *XL) /SQRT (XL**2+YL**2) 

CALL CALCMP (XV. TV, 1,1) 

C 

C **** THIS PART DRAMS THE ARROW HEADS. 

TH-AYAN2 ( (XP-XL) , (YL-YF) ) 

X«XV-.0«*SIM(T8-20.*PX/ie0.) 

T«*TV+. 06*CO8 (TH-20. *PI/180. ) 

CALL CALCMP (X.T.1.1) 

X-X7- . 06*SIN (TH+20 . +PI/180 . ) 

Y-YV+ . 06*COS (TH+20 . *PI/180 . ) 

CALL CALCMP (X,T,1,1) 

CALL CALCMP (XV, TV, 1,1) 

c : •'••• ■ 

10000 CCNTIHUX 

c 

C LOOPS S0000 AMD 60000 DRAM THE LATITUDE CIRCLES **** 

C **»* AMD MLT LIMBS AMD i-anat-g RESPECTIVELY *'** 

CALL CALCMP(0., 0,0,1) 

CALL CHAIM (0.0) 

DO 50000 I * 1, 4 
PRAD-1. 125*1 
CALL ARC (PRAD.0.,360.) 

S0000 CONTINUE 
C 

DO 60000 I - 1, 12 

ST-SIM ( (X-l) *PI/6 . ) 

CT=COS((I-l)*PI/6.) 

XL-4 . 5*CT 

YL-4.5*ST 

X-XL-3.375*CT 

T»TL-3 . 375*8T 

CALL CALCMP (X.T.0,1) 

ril.l. CALCMP (XL, YL, 1, 1) 

MLT»2.*(I-1) 

XM-XL+ . 7*CT+ . 105 

YM-YL+ . 7»ST- . 07 

IV (MLT. ST. 9) YM*YH-.14 

CALL NUMBER (XM,TM, . 21. MLT. 90 . . -1) 

60000 CONTINUE 





SBRKALC 


SOURCE CODE 



C SBRKALC . FOR 


Birkeland Current calculation 
John L. Jamison for DM Klumpar 

Lockheed Palo Alto Research Laboratory 0/91-20 B/25S 
June, 1988 


c Revision history 
o 

c 12- Jul -88 JLJ 

C 6- Jul-88 JLJ 

C 1- Jul-88 JLJ 

c 30- Jun-88 JLJ 

a 30- Jun-88 JLJ 

O 

o 29- Jun-88 JLJ 


siade into callable subroutine 
Added wax to HMKAS 
Debugging 

change ALII from 140000. to 120000. 
added input value checking code 
Cixed except for alt itude 
Initial oatry ■ : ■ . 


subroutine SBRKALC (inter , pfnun, pelt , pinol , ptheta, pnmsas , 
* pifld.pipass) 

dimension fid (4) , ften(3) 


c SBRK.XMC defines the coneon block, and eost of the shared data types 
o 

include ' nodal : [staple] sbrk. too' 
integer inter, pnmsas, pifld.pipass 
real pelt, pind.ptbeta 

character* 11 darray /'DIS.DAT; '/ 

characters fnum.pfnum 

real *4 ind.op 

data RS /6371000. / 

data alt 1 /12000Q./ (JLJ 

data pi /3. 14159265/ 

write (6,*) 

write (6,*) ' SBRKALC. BXB (Sinple) Blrkeland Current Generator' 
write (6,*) 

if (inter. eg. 0) then 
f nun ( 1 : 2 ) *>pf nun (1 : 2 ) 
altvpalt 
lpass* plpass ■ 
i fid - pi fid 
inol rn pinol 
theta" ptheta 
ruaeas" pnneas 
goto 2000 
endif 

write (6,1000) 

1000 format ('(Enter DIS.DAT version number: ') 

read (5, 1010) 

1010 fornat (2a) 


write (6,1020) 

1020 format ('(Enter Altitude ( REAL, maters ) : ') 
read (5,*) alt 

c if inputted ALT is less than 10000, then its assumed that the 
o user entered a KB value 

if (alt. gt. 0 . 0 . and. alt. It. 10000,) then 

•rite (6, *) ' Assuming Kilometers, adjusting...' 

alt«*alt*1000 . 

write <6, 1019) alt _ 


1019 


1021 


1022 


1029 

1030 


1039 

1040 


1049 

1050 

• 

* 

# 


o non 
2000 


format (' Using ',£8.0,' meters for altitude.') 

endlf 


write (6, 1021) 

format (' $Enter Inclination [ REAL, deg. from pole 1 ■ ') 
read (5,*) lncl 

write (6, 1022) 

format (' (Enter Theta [ REAL, deg from dawn-dusk line ] : ') 
read (5,*) theta 


write (6, 1030) 

format ('(Enter ouatoer of measurement points ( integer, ' 
, '<- 500 1 : 
read (5,*) nmaaa 
if (naaas.gt.500) goto 1029 


write (6, 1040) 


format ( 


Enter: 


1 for the Field of all current*'/ 

2 for Field-Aligned only' / 

3 for Vortb'Seuth only' / 

4 for East-Nest only' / 

5 for Ring current only' / 


'(> ') 
read (5,*) lfld 

if (ifld.lt.l.and.iflt.gt.S) goto 1039 


write (6, 1050) 

format(' Enter 1 for Polar'/ 

' 2 for Equatorial Neat' / 

' 3 for Equatorial East' / 

'«> ') 

rf (5#*) IptM 

if (lpass.lt.0.and.ipass.gt.3) goto 1049 
if (lpaas.eq.0) lpaas-1 


use of funO for Degrees, ratherthan fun for Radians JLJ 
darray(9:10) '- fnum(l:2) 


if (Inter. eq.l) then 
write (6,*) 'File 
writs<6, *) 'Alt 
write (6, *) ' Ipaas 
wrlte(6.*) 'lfld 
write (6,*) 'lncl 
write (6,*) ‘Theta 
write (6,*) 'Mmsaa 
write (6,*) 
endlf 


: ' , darray (1:10) 

: '.alt 
. ' i ipaoe.;.. j 
; ■ ' .ifldM* 

: ' , lncl 
: ', theta 
'.nmeas 


st> sinD (theta) 
ct- oosD (theta) 
slncl - ainD(incl) 
clncl » oosD(inol) 

open (unit-1 . nsm a- d s r ray, type-' old' ) 



o following read statements match CURDIS.FOR (Simple) NRITBs JLJ 

read (1,*) ncode, df 
read (1,*) ell, cl 2 
read (1,*) numt, numl 


numt + 1 



read (1, 
read (1, 
read (1, 
read (1, 
read (1, 
read (1, 
read (1, 
read (1, 
read (1, 
read (X, 
read (1, 
read (X, 
read (X, 
read (X, 
read (X. 
read (X, 


( ( (tp(l, J,k) , k=l , numl ) , j=l,n), 1=1,4) 

< < (amp(i, j,k) , k=X , numl ) , j=X,numt), 1=1,2) 
( (r*f <1, j) , j=l,n), 1=1,2) 

( (rb(l, j) , 3=1, n), 1=1,2) 

( (rt (l,j), 3=1, n), 1=1,2) 

(rsl(k), k=l,numt) 

(rie (1) , i=l,numt) 

<re3(l), i-l.numt) 

< (ri (1,3), 3“l<«« u »t). 1 = 1 , 2 ) 

( (*01(1,3), 3-1, n). 1=1,2) 

((col(l.j), 3-l.o), 1=1,2) 

((*«U(1,3), 3-1,0), 1-1,2) : ; 


((mu(l,3), 3-l,o), 
(<aem<i.3), 3-1,0) ) 
rlaga, rlogto 
(tpr(l) ,1-1, nual) 
(aag>r(i) ,1=1, nual) 


1 - 1 . 2 ) 


cloae (unlt-1) 

open (unlt=l, n— e-*— ag.dat* , type-' new' ) 

write (1, *) aoode, alt 
write (1,*) lnol, theta 
write (1,*) ell, al2 
write (1,*) numt.numl 
write (1,*) new a*, lfld 
writ# (1.*) lpa** : 
o 

o loop 1000 determines (X,Y,t) coords of each measurement point and calls 
o MACNOD to obtain Field parameters for each point 
c 

do 10000 lx-l.aama* . 

-v (l.-(lx-l) *2 . / (amaas-1) ) *pl*«0 . /X80 . 

* -(lpa**-i)*270.*pl/180. 

sop - ain(ap) 
cop = cos (up) 

xl- (re+alt) * (-at*ssp+ct*cnp*alncl) 

yl-(refait) * (ct**«p+at*«*p**lool) 

*X- (re+alt ) •cmp*oinal 
O 

o xl.yl.il - (X, T, t) of measurement point 

a fid - the three components of dB and FAC determined from N&GM0D 

o if id - tell* asegmod which current system* to includewhen crunching away 

call: magmod(xl,yl, xl, fid, lfld) 

wrlte(l.f) C14 ^ 

10000 continue 

close (unlt-1) 
return 

end • 5 1 \ * ;o !:>• 

program abrkalcjlt 

call *brkalc(l, r ' , 0.0, 0. 0, 0. 0, 0, 0, 0) 

•top 

end 



SMAGMOD 


SOURCE CODE 



SMAGMOD.FOR Magnetic Field Model 

John L. Jamison 

Lockheed Palo Alto Research Laboratory 0/91-20 B/2SS 
Revision History, 

7/14/88 JLJ created LAMBDAS lookup table for lambda values. 

7/1/88 JLJ debugging 

6/29/88 JLJ initial entry 


subroutine magnod (xl.yl, <1, fid, ifld) 

**** calculates current density and Magnetic field components 
**** of bl rkeland current model defined by crurdis. 


include ‘eodsl: [sisple] sbrk.ino' 

dimension famp (21, 24) , rm(3, 3) , fid (4) 

dissension bf<3), btf(3), bti(3), bte(3). btr|3) 

real*4 lambda, op, Jt 

data pi / 3.14159265 / 

real *4 lambdas (24) I [l.numl] 

create lambdas lookup table, because they're always calculated the ss 

do j*l,numl 

lambdas (J) -2 5) *pi/numl 
end do 


do 10000 1-1,3 

btf (1) - 0. 

- o. 

bte(i) - 0. 
btr(i) - 0. 

10000 continue 

Jt - 0 . 

if (ifld. eg. -2) go to 03000 

if (ifld.gt .2) go to 03000 

O80000lfl0<000l000l800ie8e080e9008809888089898989808889898888888888e888e9} 

o 

O esse loop 20000 does the field aligned current* supplying 
o sees both the e-w and n-a ionospheric currents, 
o •••* positive current is vertical, 
o 

1-numt+l •••'• 

do 20000 m - 1, 2 

if (m.eg.2) i-numt 
do 20000 n - 1, i 
do 20000 ]-l,numl 
if (n.eg.2) goto 20010 
fasg>(l, j) -asp (1,1, j) 
fampinurnt-tl, j)— asp(l,nuat, j) 
if (n.eg. (numt+1) ) goto 20020 

if (n.gt.l) famp(n, 3)=aap(l,n, J) -amp(l,n-l, j) 
if (famp (n, 1) .eg. 0. ) goto 20000 



goto 20020 


20010 famp (n, 1) =amp (2, n, numl) -amp (2, n, 1) 

If (j.gt.l) famp (n, j) =amp (2, n, J-l) -amp (2, n, j) 
if (famp(n, j) .eq.O) goto 20000 

c rearranged and optimized, JW 
c20020 lambda«2.*(j-.S)*pi/numl : 

c if (a.eq.2) lambda**2.»J»pl/numl 

c 

20020 if (m.ne.2) then 

lambda ■■ lambda# (J) 

eiae 

lambda ■ 2.*:)*pf /numl . 
eodif : 

•la - aln (lambda) 
ala » aoa (lambda) 
e 

rm(l, 1) ■ ala*awu(m,n) 

*■(1.2) « ala*cmn(m,n) 
rm(l,3) “ -amu(m.n) 
rm(2,l) • -ala 
rm(2, 2) - ola 
ra(2. 3) - 0. 

rm(3,l) • cla*smu(m,n) 

*■(3.2) .« aia*amu(m,n) 
ra(3,3) “ cmu(a,n) 
a 

xt ■ xl«rm(l,l) + yl*rm(l,2) ♦ (zl-rzf (m,n) ) *rm(l, 3) 
yf • xl*rz»<2, 1) + yl*rm(2, 2) + (zl-rzf (m.n) ) *rm(2, 3) 
tf - xl»rm(3,l) + yl*rm(3,2) + (zl-rzf (m, n) ) *rm(3, 3) 
o 

raf - xt**2 yf**2 

rbf - aqrt(rcf *• (zf-rb (m, n) ) »*2) 
rtf - aqrtjraf ♦ (zf-rt (m, n) ) **2) 
a 

fcatf m faap(n, j) * (tanh(rcf»tp(m, n, j) ) )*(yf/rof) 

1 ' * < (*t (at, n) -«<) /rtf + (zf-rb (m, n) ) /rbf) 

byf - -famp(n, J) * (tanb(rcf*tp(m, n, j) ) )* (xf/ref) 

1 *((rt(m,n)-zf)/rtf + (zf-rb (m, n) ) /rbf ) 

do 21000 ip *1,3 

bf (ip) - bxf*rm(l,ip) + byf*rm(2,ip) 
btf <ip)« btf (ip) + bf(ip) 

21000 oontinue 


if ( (tp (m, n, j) *rcf) .gt. 40.) go to 20000 


write (6,*) 
write («,*) 

write (6.*) *femp(n,3)e 
write (6,*) ’ tp(m, n, j)" 
write (6,*) ’pi 
write (6,*) 'raf “ 

write (6.!») 'jt 
write (6,*) 'aoeh “ 


e> » «... mm e* we* w W«e 


.a, a, J 
» famp(n, j) 

, tp (m, n, j) 

.Pi 

, ref 
» jt 

, ooah(tp(m, n, 3) *rcf) 


jt - famp (n, J)*tp(m,n, 3) 

/(pi*((coah(tp(m,n,3)*rcf))**2)) + 3t 


20000 continue 

if (ifld.eg.2) go to 07000 
03000 if (ifld.eg.S) go to 04000 




do 30000 n « l.numt 
do 30000 j = l.numl 

c lambda » 2 . * ( j- . 5) *pi/numl 

lambda-lambdas ( J) 

ala - aln (lambda) 
ola - cos (lambda) 

c " V ' • "Vs. 

rm(l,l) - ola*ccl (2,n) 
rm(l,2) - ala*ccl(2,n) 
rm(l,3) - -scl(2,n) 
rm(2,l) - -ola 
r*(2,2) ■ ol* 
rm(2,3) ■ 0. 

r*(3,l) - ola* sol (2,o) 

re(3,2) - ala*sol(2,n) 
rm(3, 3) - ool(2,n) 
o 

If (lfld.oq.-3) V© to 30100 
If (Ifld.eq. «> go to XHOO 

« : v * . . 

C ) 

O 

o *••• this part does tbo north-south ionospheric currants, 
o **** negative current Is northward. 

If (amp (1, a, j) .eq. 0.) qo to 99010 
o 

xf - xl*rm(l, 1) + yl*nn(1.2) + (rl-rri <n) ) *rm(l, 3) 
yf - xl*rm(2,l) + yl»rm(2,2) ♦ (rl-rxl (n) ) *rm(2, 3) 
xf m xl*rm(3,l) ♦ yl*rm(3,2) + (xl-rxl <n) )*rw(3,3) 

rof • yf**2 © if**! 

rll - sqrt (rof •» (xf - ri(l,n))**2) 
ri2 - sqrt (rof ♦ (xf - rl(2,n))»*2) 

byf • -saw (1, a, J) * (tanh (100. *rof*tp (3, n, j) ) ) * (xf /ref ) 

1 * ( ( (xf-rl (l,n) ) /rll) + (ri (2,n) -xf) /rl2) 

bxf - aapd.n, j) • (tanh (100. *rcf*tp <3. o. J) ))*(yf/«ef> 

1 * ( ( (xf-rl (1, n) ) /rll) ♦ (rl(2,n)-xf)/rl2) 


do 31000 ip “ 1,3 

bf(lp) » toyf*ns(2,ip) ♦ h«f*rm(3,lp) 
bti(lp) - btl(ip) + bf (ip) 

31000 ceatiaue 

30010 continue 

o 

If (ifld.eq. -4) go to 30000 
If (Ifld.eq. 3) go to 30000 


a •*** this part does the east-west electrojets, 
o ***» positive current Is eastward. 

30100 If (axp(2,n, j) .eq. 0.) go to 30000 

xf - xl*rm(l,l) ♦ yl*rm(l, 2) + xl*rm(l,3) 
yf - xl*rm(2, 1) + yl*rm(2,2) + xl*rm(2,3) 

*f - xl*ra(3, 1) ♦ yl*rm(3, 2) + *l*rm(3,3) 

raf - xf**2 + (xf - rxe(n))**2 
rel - sqrt (ref + (yf + rej(n))**2) 
re 2 - sqrt (ref + (yf - rej(n))**2) 

bxf - amp (2, r>, 1) * (tanh ( 100 . *rcf*tp(4, n, j) ) ) 




1 


* (zf-rze (n) ) * ( (yf+re j (n) ) /rel+ (re j (n) -yf) /re2) /ref 
bzf = -amp(2,n, j) * (tanh (100. *rcf*tp (4, n, j) ) ) 

1 *xf* ( (yf+re j (n) ) /rel+ (re j (n) -yf ) /re2) /ref 

do 32000 ip « 1,3 

bf (lp)=bxf*rm(l, ip) + bzf *rm(3, ip) 
bte(ip) = bte(ip) + bf(ip) 

32000 continue 

30000 continue 

c ' W . . • :■■■>■ '■ :, : j • > ;• • 

if (ifld.le.l) goto 04000 
if (ifld.lt. 5) goto 07000 

a 

04000 if (ifld.eg. -5) goto 07000 
o 

o **** loop 40000 calculatea field due to ring current 
do 40000 1*1 , nual 

o lenbda»2.*(i-.5)*pl/nunl 

laabda«laabdae(i) : 

ala-aln (laabda) 
ola*coa (laabde) 


ra(l,l)-ola 

ra(l,2)»ala 

ra(l,3)-0. 

ra(2,l)*-ala 

ra(2,2)-cla 

ra(2,3)*0. 

rm(3.1)*0. 

r»(3,2)-0. 

ra(3.3)-l. 


if (azqpr (i) .eg. 0. ) goto 40000 

xf-«l*rm(l,l) ♦ yl*r»(l,2) + zl*rm(l,3) 
yf-xl*na(2,l) ♦ yl*r»<2,2) + *l+rm(2,3) 
*f«xl«r»(3,l) * yl*ne(3,2) + sl*fin<3,3) 

rcf"(xf-ringa)**2 + *f**2 
rrl-agrt (rcf+ (yf+rlngb) **2) 
rr2«aqrt (rof + (yf -ringb) **2) 

taxf**aag>r (i) * (tanh (rof *tpr (i) ) ) **f 

* { (yf+rlngb) /rrl+ (ringb-yf > /rr2) /ref 
bzf *-aapr (1) * (tanh (rof *tpr (1) ) ) * (xf -rlnga) 
* ( (yf+rlngb) /rrl+ (ringb-yf) /rr2) /ref 

do 41000 lp-1,3 

bf (ip) -bxf *ra (1 . ip) +b«f *r»<3. ip) 
btr (lp)-btr(ip)+bf (ip) 
continue 


40000 continue 

o •*** loop 70000 adda fielde ftom all acuroea and converta to a.l. 
a 

07000 do 70000 ip ■ 1,3 

fid (ip) - 200.* (btf (lp)+bti(lp)+bte(ip)+btr (ip) ) 

70000 continue 

fid (4) ■ Jt "W*? 


o 


return 
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siade Into callable subroutine 
cleaned up input prompting 
debugging 

Initial integration into "Simple" system 
changed ALTI frost 140000, to 120000, 


c************************************************************* ************> 
c 

C *«*» BRKPLT PLOTS CURRENT DBN3ITT AND FLKLD COMPONENTS 
C FOUND BT BRXALC. 

c ' ■ ’• 

ciig8iii8i8ii»8*88888e«eB8e888888i8M888e8888eeee8eBee8eeeeeeeeeeeeeee88e8) 


C 

subroutine abrkplt (inter , pfnua, paode) 

DIMENSION FL(4,500), FT2N(3), FACT (4), PLD<4) 
DIMENSION FMAX(4) 

LOGICAL* 1 ATKX (16) , TEXT (8) 
character* 11 darray /'MAG. DAT; •/ 
charaoter*2 fnum, pfnua 
Integer petode, inter 

REAL* 4 HAT, INCL. JT, JTMAX, NLT, MP, HAT 
DATA PI / 3.14159265 / 

DATA RK / 6371000. / 

DATA ALTI / 120000. / I JLJ 

DATA ATKX / 'X', *T', 'J*. 

1 'H', 'S', 'V', 'J', 

2 '8', 'D'. 'V'. 'J', 

3 'A', 'B', 'S', 'J' / 


C 

•rite (6,997) 

0887 forest ('4') 

write (6, *) ' SBRKPLT. BXE 
write (6.*) • 
write (6,998) 

0998 format ('2') 


Birkel and Current Plotter' 

'• r simple Model' 


if (inter. eg. 0) then 
fnua(l:2) - pfnum(l:2) 

mode - petode 
goto 2000 
endif 


HRITB (6,01000) . , 

01000 FORMAT <'$8nter MAG. DAT version number ( Integer I . ) 

READ (6,01010) FNUM 
01010 FORMAT (2A) 

C 

01015 write (6,*) 'Select Coordinate system:’ 

WRITS (6.01020) • ■ „ ■ , 

01020 FORMAT ('OBnter 1 for XYS; 2 for HBV; 3 for SDV; 

* ,'4 for ABZ ( Integer 1 : ') 

READ (6,*) MODS 

if (mode. It . 1 . and. mode .gt . 4) goto 1015 


C 




uuuuu 


02000 darray (9 : 10) =fnum(l : 2) 


if (inter. eq.l) then 

write (6,*) 'File : ', darray (1:10) 
write (6,*) 'Mode : ' ,mode 
write (6,*) 
andif 

OPEN (BSIt-l . NAME-DARRAT, TYPE-' OLD' ) 

READ (1,*) MCODE , ALT 
READ (1,*) INCL, THETA 
READ (1,*) CL1 , CL2 
BEAD (X,*) HUNT, WML 
READ (1,*) HMBAS,X7LD 
READ (1.*) IP ASS 
DO 10000 J - 1, NMEAS 
READ (1,*) FLD 
DO 10000 1-1,4 
71.(1, J) - PLD(I) 

10000 conim 

CLOSE (UNIT-1) 

c 

SZHCL - SIN(PI*INCL/180.) 

CIHCL - COS (PI*INCL/180 . ) 

CT - 3IN(PI*THBTA/180. ) « .}*&■ 

CT - COS (PI*THBXA/180. ) 

C 

a (MODE .LE. 1) GO TO 11111 

***» CONVERT TO IBP 0 12; SUV OB 3; ABE OH 4 

DO 11000 J - 1, NMEAS 

IIP - (1 . - ( J-l) *2 . / (NMBAS-1) ) *PI*40 . /180 . 

1 - (IPASS-1) *270 . *P1/180 . 

SMP - SXH(KP) 

CMP - COS(MP) 

XL - -ST*SMP + CT*CNP*SINCL 
TL - CT*8MP + ST*CMP*SINCL 
CL - CMP*CINCL 
FTBM(l) - PL (1 , J) 

PTKM(2) • 7L(2, J) 

FTEM (3) - FL(3, J) 

01 - SORT (XL* *2 ♦ EL**2) 

Q2 - SQRT (YL**2 + EL**2) 

Q3 - SQRT(XL**2 ♦ YL**2) 

C 

FL(3,J) * ~VTBM(1)*XL - PTBM(2) *XL - VTSM(3)*EL 

C ' '•' V.::. ' . ; i - ^ 

XV (MODE .EQ. 3) 00 TO 11010 
c 

FL(1, J) - -PTEM(l) *XL*ZL/Q3 - FTBM(2) *YL*ZL/Q3 + FTEM(3)*Q3 
FL(2,J) - -FTEM (1 ) *YL/Q3 + FTBM(2) *XL/Q3 
IF (MODE .BO. 2) CO TO 11000 
FTBM(l) - FL(1,J) 

FTEM<2) - FL(2.J) 

FL (1 , J) - FTEM (1) *COS (PI/ 60 . ) - FTEM (2) *SIN (PI/60 . ) 

FL (2, J) - FTEM(1)*SIN (PI/60.) + FTEM (2) *COS (PI/60 . ) 

GO TO 11000 

11010 FL(l.J) - ( FTBM(1)*ZL + FTEM(3) *XL) /Q1 
FL(2, J) - (-FTBM(2)*BL - FTBM(3)*TL)/Q2 
11000 CONTINUE 

c88880888e888eee88888e88888eB80e8e888888*e8888e88ee«88eeeee8ee88eeee88e88e) 
c 



C **** FIND MAXIHA 
C 

11111 DO 12000 1-1,4 

DO 12000 J - 1 , NMEAS 

FMAX(I) - AMAX1 (ABS (FL (I, J) ) , FMAX (I) ) 

12000 CONTINUE 

FMAX(1)-AMAX1 (FMAX (1) , FMAX (2) ) 

FHAX ( 2 ) -FMAX ( 1 ) 

C ' v .7 • i; 

CALL CALCMP (X, Y, 2, 0) 

CALL CALCMP (X.T, 0,2) 

C 

ceeaaeiaieiatigeiemMMMMMMsieeeeeeeeeemeeemgegggggemeeeeeeeeg) 

C 

c ***• PLOT BACKGROUND 
C 

xorq-0 . 
yorg-0 . 

0*11 0*10*4? (xorg, yory, 0, 3) ' 

o*ll putlnfo(d*rx»y(l:10),13.O,l.O,O.lO, .(tlit.) 

XORC - .IS 
YORG - .1 

r*u. CALCMP (XORC, TORG, 0, 3) 

C ’ ’f'^'XW V'.:’ . •••• ..-V:.,. , •. 

DO 20000 I * 1,9 

X - l. ’ x' X'7 ' • • . x -V? ‘ ' ^ 'V> 

Y - ( 1 - 1 ) * 1 . 2 + .8 

CALL CALCMP (X, Y, 0,1) 

X - 11. 

» • (I-l)*1.2 ♦ .8 
CALL CALCMP (X,Y, 1,1) 

XV (X -BO 9) CO TO 20000 
DO 20000 J - 1,18 

■ - J 

IF (J .CT. 9) H - J - 9 

XL - 1. • , • ->■ ^ 

IF (J .CT. 9) XL’- 10.9 

X - XL 

Y - (H/10. + I - 1) *1 . 2 ♦ .8 
CALL CALCMP (X.Y, 0.1) 

X - .1 + XL 

Y - (H/10. 4 X * 1)*1.2 ♦ .8 
CALL CALCMP (X, Y, 1 , 1 ) 

20000 CONTXNQX 'V/X'. .f X':X: 

ciaaiiMMMiiaeaaaiaeaaaaaaaaaaeaaaaaeeaaaaBaasaaaaaaaaeaaaeaaaaaaeaeeeea) 

C 

C **•* INDICATE CEOLAT, XXVLAT. MLT 

C ’ ’-r 

d goto 30000 
o 

DO 30000 I - 1, 6 

DO 30000 J - 5, 85, 5 

6 . (45-J) *PI/180 . - (IP ASS-1) *270 . *PI/180. 

OJ - l.*J ♦ 5. ■" 

SC - SIN (C) 

CG - COS (G) 

XL - -8Y*SG ♦ CT*CG*SINCL 
YL - CT*SG + 8T*CG»SINCL 
XL - CC*CXNCL 
EL - SQRT (XL* *2 ♦ YL**2) 
c 

CLAT - 180 . * (ACOS (SQRT (XL**2+YL**2) ) ) /PI 
GLATR - GLAT*FI/180. 

ILAT - 1 80 . » IACOS ( (SQRT (RH/ (RE+ALT) ) ) «COS (GLATR) ) ) /PI_ 


MLT = ASIN (YL/RL) *12 . /PI + 12. 

IF ((XL .LT. 0.) .AND. (YL .GT. 0.)) 

1 MLT - ASIN (-XL/RL) *12 . /PI + 18. 

IF ((XL .LT. 0.) .AND. (YL .LT. 0.)) 

1 MLT - ASIN (- YL/RL) *12 . /PI 

IF ((XL .GT. 0.) .AND. (YL .LT. 0.)) 

1 MLT « ASIN (XL/RL) *12 . /PI + 6. 

C 

W - 6. - (G+ (IPASS-1) *270. *PI/180.)/. 13962 641 
IF (I .BQ. 6) GO TO 30010 
H - (1-1) *2.4 ♦ .8 

X - N 

T - -.05 V : ■ : ; : 

CALL CALCMP(X,Y,0.1) 

x - w 

Y - .05 -f H 

CALL CALCMF (X. Y, 1, 1) 

GO TO 30000 

30010 ZF (ABS (AM0D(GJ, 10. ) ) .GT. 0.) GO TO 30000 

B • .8 

XX • W - .29 
YM - B - .24 

m.t. NUMBER (XN.YN, . 14, CULT, 0. . 2) 

XX • » - .29 
YX - H - .43 

CALL NUMBER(XX,YN. ,14. JLAT,0.,2) 

XX - X - .29 
YX - B - .66 

CALL NUMBER (XX, YX, . 14 f MLT. 0 . , 2) 

30000 CONTINUE 

c 

C •*»* DRAM LATITUDE CIRCLES 
C 

CNORM-SIM (40 . *PI/180 . ) 
o CALL CALCMF (12.9,8:7,0,3) • 

CALL CALCMF (12.7,8-7,0.8) 

CALL CALCMF (0.,0.,0,1) 

CALL CRAIN (0.0) 

ZF (IPASS.GT. 1) GO TO 04200 

DO 40000 I • 10,40,10 

PRAD-SIX (I*PI/180 . ) /CNORM - 
CALL ABC (FBAD.0- ,380.) 

40000 COMTIXUB 
C 

c OR EQUATORIAL VIEW OF THE BARTH 

C 

IF (XFAS8.BQ.1) GO TO 05000 
04200 CALL CALCMF (X,Y.1,~5) 

DO 42000 1-1,9 

CRAD-COS ( (1-5) *PI/18 . ) 

X-SIX ( (1-5) *PI/18. ) /CNORM 

Y-CRAD /CHORE 

CALL CALCMF (X.Y.0,1) 

Y— CRAD/CXORM 

CALL CALCMF (X.Y.l.l) 

42000 CONTINUE 


DO 43000 1-10,190,10 

CRAD— COS( (I-10)*PI/180. ) 

DO 43000 J-1,81 

X-SIN ( ( J-41) *PI/180 . ) /CNORM 
Y— CRAD*COS ( (J-41) *PI/180. ) /CNORM 
IF (J.BQ.l) CALL CALCMP (X,Y,0,1) 



CALL CALCMP (X,Y,1,1) 

43000 CONTINUE 

CALL CALCMP (X,Y,0,-5) 

C 

ceeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeseeessseeeeeeeeeeeeeeseeeeeee) 

C 

C **** INDICATE TIKE 

C •■•'••••••.' . r: 

05000 CALL CALCMP (XORC, YORG, 0, 3) • 

IP-1 

IF (IPASS.GT.l) IP-2 
DO 50000 I - 1, 4 

S - SIN ( (1-1 .) *PI/2, ) 

C - COS ( (1-1 .)*PI/2.) 

IP (IPASS.CB.2) CO TO 50001 
o X - . 25*S + 12.15 

X - . 25*S + 12.55 

Y - - . 25*C +8.6 
CALL CALCMP (X,Y, 0,1) 

o X - S +12.15 

X - 8+12.55 

Y - -C + 8.6 

CALL CALCMP (X,Y, 1,1) 

50001 RMOM - (1-1) *6. 

CO TO (50010,50020,50030,50040) I 
cSOOlO XL - 12.12 

50010 XL - 12-52 

YL - 1 . 4- (IP-1) • . 6 

CAM. NUMBER (XL, YL, .14, RNUM,0.,-1) 

CO TO 50000 

o50020 XL - 13.82 ' ^ 

50020 XL - 13.62 
YL • 8 . 53 

IF (IPASS.CB.2) GO TO 50021 
CAM. NUMBER (XL, YL. .14, RNUM,0.,-1) 

GO TO 50000 

50021 CALL SYMBOL (XL, YL, .14, IBM, 0, ,1) 

CO TO 50000 

O50030 XL - 12. 63+ (IP-1) *.001 

50030 XL - 12. 43+ (IP-1) *.001 
TL - 9. 61+ (IP-1) *.6 
CALL NUMBER (XL, YL, .14,RNUM, 0. , -1) 

CO TO 50000 • 

O50040 XL - 11.45+ (IP-1) * . 18 

$0040 XL - 11 . 25+ (IP-l) * . IS 
YL - 8.53 

IP (IPASS.CB.2) GO TO 50041 
CAM. NUMBER (XL, YL, . 14, RNUM, 0 . , -1) 

CO TO 50000 

50041 CALL SYMBOL (XL,YL, .14, IBS, 0. ,1) 

50000 CONYXVUX • ’ ■ 

C8080800880800808008080888888888888808888808888888888880880888888688888888) 

C 

C •**• PLOT ORBIT 


C 

06000 DO 60000 I - 1, NMSAS 

MP - (l.-(I-l)*2./ (NMEAS-1) ) *PI*40 . /180. 
1 - (IPASS-1) *210. *PI/180. 

SMP - SIN (MP) 

CMP - COS (MP) 

XL - -ST*SMP + CT*CMP*8H!CL 
YL - CT*SMP + ST*CMP*SI*CL 
XL - CMP*CINCL 
o X— YL/CNORM+12 . 15 

X— YL/CNORM+12 ■ 55 . 



Y= XL/CNORM+8 . 6 

c IF (IPASS.GB.2) X=ZL/CN0RM+12 . 75 

IF (IPASS.GB.2) X-ZL/CNORM+12.55 
IF (I .EQ. 1) CALL CALCMP (X, Y, 0, 1) 

CALL CALCMP (X,Y, 1,1) 

60000 CONTINUE 
C 

IT (MODS .CT. I) GO TO 07000 

C ••••■•• :r> .• 

cmemegmeeeeemeeeeemmeeseemmeegeeeeeeeeeeeeeeeeeemegeeeeB) 

C 

c SHOW X,Y VECTORS 

C ■' ■■ /V : V S =k : A- 

o X • 11.38 

X - 11.38 

Y - 9.07 

CALL CALCMP (X,Y, 0,1) 
o X - 11.98 

X » U. 98-0.2 

Y - 9.07 

CALL CALCMP (X.Y. 1.1) 
a X - 11.98 

X - 11.98-0.2 

Y - 9.47 

cu.i. CALCMP (X.Y. 1.1) 

a CALL SYMB0L(11.82,9.3, .14,1HX,0.,1) 

CALL SYMBOL <11 82 . 9 . 5r0 . 2, , 14. 1BX. 0 , , 1) 
a CALL 8YMBOL(11.42,9.07, . 14, 1HY, 0 . , 1) 

CALL SYMBOL(ll. 42, 9.07-0.2, . 14, 1HY, 0. , 1) 

C 

CMMMMIIMMMeiMeiMMMMMMMMMMMMeaeWWM'MeeemMBeeteM) 

c 

C **** XMPXCATB MAXIMA" 

c 

07000 IPLT-4 

IP (IPLD.BQ.-2) IPLT-3 
IP (IPLD.CT.2) IPLT-3 
DO 70000 I - l.IPLT 

IP (X.HB.4) GO TO 70009 

IP (PMAX(4) . NX.0.) GO TO 70005 

IDBO-1 

ITY-1 

PACT (I) >1. 

GO TO 70063 

70003 IP (I.XQ.4) PMAX (I) -PMAX (I) *1000000 . « : 

IDBC— 1 

IP (FMAX(I) .LT.10.) IDBC-1 
IP (PMAX (I) . LT . 1 . ) IDBC-2 
IP (VMAX(I) .LT. .1) 10X03 
PACT (I)-l . 

70010 IP (PMAX (I) .G8.10. ) CO TO 70020 
IP (PMAX(I) .LT.l.) GO TO 70030 
IP (PMAX (I) .GB.l.) GO TO 70040 
70020 PACT (I) “FACT (I) /10 . 

PMAX (X) ■PMAX (X)/10. 

GO TO 70010 

70030 PACT (I) -PACT (I) *10. 

PMAX (I) -PMAX (I) *10. 

GO TO 70010 

70040 IP (INT (PMAX (I) ) . LT. INT (PMAX (I) + . 5) ) GO TO 70050 
PMAX (I) - (AINT (PMAX (I) ) + . 5) /PACT (I) 

GO TO 70060 ' 

70050 PMAX (I) -AINT (PMAX (I) +.5) /PACT (I) 


70050 

C 

70060 


IP (PMAX (I) .LT. 1000.) ITY-1 
IP fFMAX(I) . LT. 100. ) ITY-2 


IP (FMAX (I) .LT.10.) ITY=1 
IP (FMAX(I) .LT.l.) ITY=1 
IP (FMAX (I) . LT . . 1) ITY—1 
IP (FMAX(I) .LT. .01) ITY— 2 
7006S XL - 1.2 

YL - (5-1) *2 . 4 + .4 
N - I ♦ (HODB-I) M 
CALL SYMBOL (XL.YL, . 2B, ATEX (H) , 0 . , 1) 
nr (I .BQ. 4) CALL SYMBOL (999. , 999. , . 1, 1HV, 0 . , 1) 

XL - ITY* . 14+ . 4 
YL - (5-1) *2 . 4 .6 

CALL NUMBER (XL, YL, . 14, PMAX (I) , 0 . , IDEC) 

PM - 0. 

XL*. 8 . . 

YL - (5-1) *2.4 - .47 

CALL NUMBER (XL, YL, . 14, PM, 0. , -1) 

PM— FMAX (Z) 

XL-ITYV14+.26 

XT (FMAX(I) .BQ.O.) XL»*L4.14 V 

YL - (5-1) *2. 4 - 1.55 

CALL NUMBER (XL.YL..14.FM.0..IDBC) 

XL-. 2 

YL- (5-1) *2. 4-1.1 
IF (X.BQ.4) CO TO 70070 

CALL SYMBOL (XL. YL, . 14, LOHKAMOTBSLAS, 80, , 10) 

CO TO 70080 
70070 YL-YL-.15 

CALL SYMBOL (XL. YL, . 14, 11BMICRQAMPS/M. 90. . 11) 

XL-XL-.l 
YL— YL+1 . 54 

CALL SYMBOL (XL. YL, . 07, 102, 90. , 1) 

70080 XT ((X.BQ.4) .AMD. (FMAX(I) .BQ.0.)) GO TO 70000 
XV (X.BQ.4) FMAX(I)«FMAX(I) /1Q00000. 

70000 COMTIMUB 
C 

C8B88BBBB8B988888888088888888888888888B88888888888888888868888686888888888) 

c : 

C •**» FLOY FIELDS 
C 

DO 80000 I - l.IFLT 

IF ((X.BQ.4) .AND. (ALT.LT.ALTX) ) GO TO 80000 

o don't plot If FMAX (I) » 0.0, othorwl** boato* out with FLTDXVZ8R :: 

If (£nax(i) .•q.0.0) goto 80000 


DO 80000 J « l.MMBAS 

MP - (J-l)*2./ (NMEAS-1) 

X - 5.*MP + 1. 

Y - 2.4* (4-1) + 2. + 1.2*FL(I,J)/FMAX(I) 

XF <J .BQ. 1) CALL CALCMF(X.Y. 0,1) 

IF (O .BQ. 1) CO TO 80000 
CALL CALCNF (X, Y, 1, 1) 

80000 CONTINUE 

C888888888888888888l8888888888888888888888888B888B88888888888888888888fMf) 

C 

CALL CALCMP (0 . , 0 . , 0, 3) 

rn.T. SYMBOL (0. ,10.64, .35, 21BB-FIBLD OF BIRKBLAND ,0.,21) 

CALL SYMBOL (999. , 999. , . 35, 13HCURRBNT MODEL, 0., 13) 

CALL SYMBOL (0 . , . 66, . 14, 6HGEOLAT, 0 . , 6) 

CALL SYMBOL (0. ,0.45, .14, 6HIMVLAT, 0. , 6) 

CALL SYMBOL <0. ,0.24, . 14, 3BMLT, 0. , 3) 

ORY-7.2 

IF (IFASS.GB.2) ORY-6.5 

rn.T. SYMBOL (12 .55, ORY, . 14, 5HORBIT, 0 . , 5) 

CALT - ALT/1000 . 



CALL SYMBOL (11 .7,6.0, .14, 17HALTITUDE 
CALL NUMBER (13.2.6.0, .14, CALT, 0 . , -1) 
RCODE - NCODE 

CALL NUMBER (12. , 0. , . 14, RCODE, 0. , 0) 
CALL NUMBER (999., 999., . 14 , CL1, 0 . , 0) 
CALL NUMBER (999. , 999. , . 14, CL2, 0 . , 0) 
RUMT-NUHT 

CALL NUMBER (999., 999., .14,RDMT, 0. , 0) 
RUML-HUML 

CALL NUMBER(999. , 999. , .14, RUML , 0. , 0) 
RFLD-1FLD 

CALL NUMBER (999., 999., . 14, RFLD, 0 . , 0) 





